#!/usr/bin/env perl

use strict;
use warnings;

die "Usage: ./gm <input_file>" unless @ARGV == 1;

my $file = shift @ARGV;
my $filesize = -s $file;
my $abi; # file buffer
open ABI, "<$file";
binmode ABI;
read ABI, $abi, $filesize;
die "don't know what to do with this file; expecting ABIF" if substr($abi, 0, 4) ne 'ABIF';

my %aflp;
my @param;
my @size;
my $gelname;
my $gellane;
my $numdye;
my @dyepeak;
my $numlane;


my $indexadd=unpack "N",substr($abi,26,4);
my $indexlen=unpack "N",substr($abi,18,4);

# typedef struct {
#   char[4]     tag,
#   long        tag_number,  /* for multiple tag entries */
#   short       data_type,   /*
#                                2 = simple array of ASCII chars
#                                4 = integer
#                                5 = long ?
#                                7 = float
#                               10 = mm/dd/yy
#                               11 = hh/mm/ss
#                               18 = pString
#                               19 = c-string? (null-terminated)
#                             1024 =
#                             */
#   short       element_length,      /* referenced data element length in bytes <- $elemlen
#   long        number_of_elements,  /* number of referenced data elements */   <- $numelem
#   long        record_length,       /* legth of the refernced data array */    <- $totlen
#   long        data_record,         /* the data, if record_length 4 bytes or less, else offset to data from file start */
# }

my %type = (
	    2 => "ascii",
	    4 => "integer",
	    5 => "long",
	    7 => "float",
	    10 => "date",
	    11 => "time",
	    18 => "pstring",
	    19 => "asciiz",
          1024 => "TYPE 1024",
);

for my $i ( 0 .. $indexlen-1) {
  my $offset = $i*28 + $indexadd;
  my ($tag, $tagnumber, $datatype, $elemlen, $numelem, $totlen) = unpack "a4NnnNNN", substr($abi, $offset, 20);
#  print "($tag, $tagnumber, $datatype, $elemlen, $numelem, $totlen)\n";

  my $data_offset = $totlen > 4 ? unpack("N", substr($abi, $offset+20, 4)) : $offset+20;

  my $output;
  if ( $datatype == 2 && $elemlen == 1 ) {
    $output = '"' . substr($abi, $data_offset, $totlen) . '"';
  }
  elsif ( $datatype == 4 ) {
    my $data = substr($abi, $data_offset, $totlen);
    my @buf = unpack "C" x (2*$numelem), $data;
    my @arr;
    foreach my $i ( 0 .. @buf/2 - 1 ) {
      # swap bytes
      my ( $high, $low ) = ($buf[2*$i], $buf[2*$i+1]);
#      print "$i -> ( $high, $low )\n";
      push @arr, unpack("s", pack( "CC", $low, $high ));
    }
    if ( @arr > 20 ) {
      $output = "@arr[0..19] ...";
    }
    else {
      $output = "@arr";
    }
    if ( $tag =~ /data|buft/i ) {
      open OUT, ">$tag$tagnumber.tab";
      print OUT join("\n", @arr, '');
      close OUT;
    }
  }
  elsif ( $datatype == 7 ) {
    my $data = substr($abi, $data_offset, $totlen);
    my @arr = unpack "f" x $numelem, $data;
    if ( @arr > 20 ) {
      $output = "@arr[0..19] ...";
    }
    else {
      $output = "@arr";
    }
  }
  elsif ( $datatype == 5 ) {
    my $data = substr($abi, $data_offset, $totlen);
    my @arr = unpack "L" x $numelem, $data;
    if ( @arr > 20 ) {
      $output = "@arr[0..19] ...";
    }
    else {
      $output = "@arr";
    }
  }
  elsif ( $datatype == 10 ) {
    my ($y, $m, $d) = unpack "nCC", substr($abi, $data_offset, $elemlen);
    $output = "$y/$m/$d";
  }
  elsif ( $datatype == 11 ) {
    my ($h, $m, $s) = unpack "CCC", substr($abi, $data_offset, $elemlen);
    $output = "$h:$m:$s";
  }
  elsif ( $datatype == 18 && $elemlen == 1 ) { # length 1 indicates a pascal string type
    my $strlen = unpack "C", substr($abi, $data_offset, 1);
    $output = '"' . substr($abi, $data_offset + 1, $strlen) . '"';
  }
  elsif ( $datatype == 19 ) {
    my $buf = substr($abi, $data_offset, $totlen-1);
    $output = "\"$buf\"";
  }
  else {
    my @arr = unpack("C" x $totlen, substr($abi, $data_offset, $totlen));
    $output = "@arr";
  }
  print "$tag $tagnumber\t" . ($type{$datatype} or "UNKNOWN") . "\t$output\n";
}
__END__
  } elsif($tag eq 'PEAK') {
    my $record=unpack "N",substr($abi,$offset+20,4);
    for my $j(0..$numelem-1) {
      my($dye,$point,$height,$null,$area,$null2,$size)=unpack "nnna14na4f",substr($abi,$record+96*$j,30);
      print STDERR "$dye\t$point\t$height\t$area\t$size\n";
      next if $size<$AFLPstart;
      push @size,$size;
      push @param,$height;
    }
  }
}

